home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
dbms_mag
/
9108
/
account2.aug
< prev
next >
Wrap
Text File
|
1991-06-13
|
8KB
|
207 lines
Listing 2
0001: PROCEDURE gethdr
0002: * Procedure to get or modify the transaction header
0003: * The transaction number is assign for new transactions only
0004: * by incrementing the last transaction. This technique would
0005: * not be suitable to a multi-user application.
0006: * This procedure will also set up and call the engine if the
0007: * transaction is accepted.
0008: IF c_new_rec
0009: GO BOTTOM
0010: tran_no = tranhdr->Tran_No + 1
0011: tran_desc = SPACE(LEN(tranhdr->Tran_Desc))
0012: tran_amt = 0
0013: ELSE
0014: tran_no = tranhdr->Tran_No
0015: tran_desc = tranhdr->Tran_Desc
0016: tran_amt = tranhdr->Tran_Amt
0017: ENDIF
0018: SET COLOR TO &vid_nrml
0019: @ 5,0 CLEAR
0020: @ 5,5 TO 11,74 DOUBLE
0021: @ 6,10 SAY "Transaction Number"
0022: @ 8,17 SAY "Description"
0023: @ 10,22 SAY "Amount"
0024: SET COLOR TO &vid_bright
0025: @ 6,30 SAY m->tran_no PICTURE "###"
0026: SET COLOR TO &vid_rvrs
0027: @ 23,0 SAY "Press Esc to return to menu"
0028: SET COLOR TO &vid_nrml
0029: c_amc = 2
0030: DO WHILE c_amc = 2
0031: @ 8,30 GET m->tran_desc
0032: @ 10,30 GET m->tran_amt PICTURE "999999.99 "
0033: READ
0034: key_press = keypress()
0035: IF key_press = 12 && Escape
0036: RETURN
0037: ENDIF
0038: DO qamc WITH IIF(c_new_rec,2,1) && Add record as displayed or
0039: && Save record with changes
0040: ENDDO
0041: IF c_amc = 1
0042: SELECT tranhdr
0043: IF c_new_rec
0044: APPEND BLANK
0045: REPLACE Tran_No WITH m->tran_no
0046: ENDIF
0047: REPLACE Tran_Desc WITH m->tran_desc, ;
0048: Tran_Amt WITH m->tran_amt
0049: SET SAFETY OFF
0050: SELECT Dstrwork
0051: IF c_new_rec
0052: ZAP
0053: rmng_2_bal = tranhdr->Tran_Amt
0054: ELSE
0055: USE
0056: SELECT trandstr
0057: SET DELETED ON
0058: COPY TO Dstrwork FOR Tran_No = tranhdr->Tran_No
0059: SELECT 3
0060: USE Dstrwork
0061: rmng_2_bal = tranhdr->Tran_Amt - tranhdr->Dstr_Total
0062: ENDIF
0063: SET SAFETY ON
0064: * Scope memory variables for distribution
0065: STORE SPACE(LEN(trandstr->Dstr_To)) TO dstr_to
0066: STORE 0 TO dstr_amt
0067: * Assign procedures for engine
0068: zd_screen = "DO dstrscn"
0069: zd_display = "DO dstrdsp"
0070: zd_init = "DO dstrinit"
0071: zd_get = "DO dstrget"
0072: zd_append = "DO dstrapp"
0073: zd_modify = "DO dstrmod"
0074: zd_insert = "DO dstrins"
0075: zd_delete = "DO dstrdel"
0076: zd_file = "DO dstrfile"
0077: zd_alias = "dstrwork"
0078: * Call the engine
0079: DO zerodstr WITH (rmng_2_bal)
0080: ENDIF
0081: RETURN
0082:
0083: PROCEDURE dstrscn
0084: * Paint screen for distribution
0085: * this procedure name is assigned to variable zd_screen
0086: SELECT Dstrwork
0087: @ 12,0 CLEAR
0088: @ 12,5 TO 20,74 DOUBLE
0089: @ 15,6 TO 15,73
0090: @ 15,5 SAY CHR(199)
0091: @ 15,74 SAY CHR(182)
0092: @ 13,11 SAY "Distribution Item"
0093: @ 13,37 SAY "of"
0094: @ 14,8 SAY "Remaining to Balance"
0095: @ 16,15 SAY "Distribute to"
0096: @ 18,22 SAY "Amount"
0097: SET COLOR TO &vid_bright
0098: @ 13,31 SAY cur_item PICTURE "9999"
0099: @ 13,40 SAY last_item PICTURE "9999"
0100: @ 14,31 SAY rmng_2_bal PICTURE "999,999.99"
0101: SET COLOR TO &vid_nrml
0102: RETURN
0103:
0104: PROCEDURE dstrdsp
0105: * Display current distibution item
0106: * this procedure name is assigned to variable zd_dsp
0107: SET COLOR TO &vid_bright
0108: @ 13,31 SAY cur_item PICTURE "9999"
0109: @ 13,40 SAY last_item PICTURE "9999"
0110: @ 14,31 SAY rmng_2_bal PICTURE "999,999.99"
0111: @ 16,31 SAY Dstrwork->Dstr_To
0112: @ 18,31 SAY Dstrwork->Dstr_Amt PICTURE "999,999.99"
0113: SET COLOR TO &vid_nrml
0114: RETURN
0115:
0116: PROCEDURE dstrinit
0117: * Initialize memory variables to get an item
0118: * this procedure name is assigned to variable zd_init
0119: dstr_to = Dstrwork->Dstr_To
0120: dstr_amt = IIF(c_new_rec,rmng_2_bal,Dstrwork->Dstr_Amt)
0121: RETURN
0122:
0123: PROCEDURE dstrget
0124: * Get and read
0125: * this procedure name is assigned to variable zd_get
0126: @ 16,31 GET m->dstr_to PICTURE REPLICATE("!",LEN(m->dstr_to))
0127: @ 18,31 GET m->dstr_amt PICTURE "999999.99 "
0128: READ
0129: RETURN
0130:
0131: PROCEDURE dstrapp
0132: * Append item to Dstrwork
0133: * this procedure name is assigned to variable zd_append
0134: SELECT Dstrwork
0135: APPEND BLANK
0136: rmng_2_bal = m->rmng_2_bal - m->dstr_amt
0137: finished = (rmng_2_bal = 0.)
0138: DO dstrrepl
0139: RETURN
0140:
0141: PROCEDURE dstrmod
0142: * Modify item in Dstrwork
0143: * this procedure name is assigned to variable zd_modify
0144: * Update rmng_2_bal with difference between old and new values,
0145: * and do it before the replace !!
0146: rmng_2_bal = m->rmng_2_bal - m->dstr_amt + Dstrwork->dstr_amt
0147: DO dstrrepl
0148: RETURN
0149:
0150: PROCEDURE dstrins
0151: * Insert item in front of current item
0152: * this procedure name is assigned to variable zd_insert
0153: SELECT Dstrwork
0154: INSERT BLANK BEFORE
0155: rmng_2_bal = m->rmng_2_bal - m->dstr_amt
0156: DO dstrrepl
0157: RETURN
0158:
0159: PROCEDURE dstrrepl
0160: * Replace database fields with value of corresponding memory variables
0161: * This procedure name IS NOT assigned to a zd_ variable, but it is
0162: * called by procedures dstrapp, dstrmod, and dstrins, and keeps the
0163: * writes to the database fields in a single procedure
0164: REPLACE Dstr_To WITH m->dstr_to, Dstr_Amt WITH m->dstr_amt
0165: RETURN
0166:
0167: PROCEDURE dstrdel
0168: * Delete item from Dstrwork
0169: * this procedure name is assigned to variable zd_delete
0170: * DELETE and PACK statements are in calling procedure
0171: * only need to adjust rmng_2_bal
0172: SELECT Dstrwork
0173: rmng_2_bal = rmng_2_bal + Dstrwork->dstr_amt
0174: RETURN
0175:
0176: PROCEDURE dstrfile
0177: * Distribution has been accepted - write it to permanent files.
0178: * this procedure name is assigned to variable zd_file
0179: * If we are modifying a previous transaction, we need to delete the
0180: * the old distribution if the field tranhdr->Dstr_Count is non-zero.
0181: * After the new distribution is saved, ZAP the workfile.
0182: SELECT Dstrwork
0183: PACK
0184: REPLACE tran_no WITH tranhdr->Tran_No FOR .T.
0185: USE
0186: SET DELETED ON
0187: SELECT trandstr
0188: IF tranhdr->dstr_count <> 0
0189: LOCATE FOR Tran_No = tranhdr->Tran_No && not using an index in
this sample
0190: DELETE WHILE trandstr->Tran_No = tranhdr->Tran_No
0191: ENDIF
0192: APPEND FROM Dstrwork
0193: SELECT tranhdr
0194: REPLACE dstr_count WITH last_item, dstr_total WITH tran_amt -
rmng_2_bal
0195: SELECT 3
0196: SET SAFETY OFF
0197: USE Dstrwork
0198: ZAP
0199: SET SAFETY ON
0200: RETURN